home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Input 64
/
Input_64_86-05_1986_Verlag_Heinz_Weise_de.d64
/
tracer .lsp
< prev
Wrap
Text File
|
2023-02-26
|
2KB
|
52 lines
(trace fexpr (nlambda l (setq
trace-spaces 0) (no-single-step) (
mapc (quote (lambda (func) (prog (x) (
setq x (or (getprop func (quote expr))
(getprop func (quote fexpr)) (
getprop func (quote macro)) nil)) (
cond ((null x) (return nil))) (rplacd
(cdr x) (list (list (quote evtrace)
func (cadr x) (cddr x))))))) l) l))
(untrace fexpr (nlambda l (setq
trace-spaces 0) (mapc (quote (lambda (
func) (prog (x) (setq x (or (getprop
func (quote expr)) (getprop func (
quote fexpr)) (getprop func (quote
macro)) nil)) (cond ((null x) (return
nil))) (rplacd (cdr x) (last (last x))
)))) l) l))
(evtrace fexpr (nlambda (trfun trvars
trbody) (prog (trresult) (printentry
trfun trvars) (setq trresult (apply (
quote progn) trbody)) (printexit
trfun trresult) (return trresult))))
(printentry expr (lambda (trfun
trvars) (spaces (setq trace-spaces (
add1 trace-spaces))) (msg "entering "
trfun " [") (printentry1 trvars) (msg
"]" t) (cond (single-step-v (waitchar)
))))
(printentry1 expr (lambda (trvars) (
cond ((null trvars) nil) ((atom
trvars) (prin1 (eval trvars))) ((atom
(cdr trvars)) (prin1 (eval (car
trvars)))) (t (prin1 (eval (car
trvars))) (msg ",") (printentry1 (cdr
trvars))))))
(printexit expr (lambda (trfun
trresult) (spaces (setq trace-spaces (
sub1 trace-spaces))) (msg
" exiting " trfun " = ") (print
trresult) (cond (single-step-v (
waitchar)))))
(single-step expr (lambda nil (setq
single-step-v t)))
(no-single-step expr (lambda nil (
setq single-step-v nil)))
(single-step-v value nil)
(tracfns value (trace untrace evtrace
printentry printentry1 printexit
single-step no-single-step
single-step-v tracfns))
nil